/* Declarations for the function types.

   This file is part of khipu.

   khipu is free software: you can redistribute it and/or modify
   it under the terms of the GNU Lesser General Public License as published by
   the Free Software Foundation; either version 3 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU Lesser General Public License for more details.

   You should have received a copy of the GNU Lesser General Public License
   along with this program.  If not, see <https://www.gnu.org/licenses/>.  */

#ifndef __KP_FUNCTION__
#define __KP_FUNCTION__   1

#include "interp.hpp"

KP_DECLS_BEGIN

struct function_base : public varobj
{
  static const int native_flag = 1 << 16;
  static const int artificial_flag = 1 << 17;
  static const int kwargs_flag = 1 << 18;
  static const int genericfn_flag = 1 << 19;

  static const int code = typecode::FCT;

  int min_argc;
  int max_argc;
  object name;

  bool test_nargs (interpreter *interp, uint32_t n, bool raise = true) const
    {
      if (n >= (uint32_t)this->min_argc && n <= (uint32_t)this->max_argc)
        return (true);
      else if (!raise)
        return (false);

      interp->raise_nargs (this->name,
        this->min_argc, this->max_argc, n);
    }

  void local_init ()
    {
      this->vo_full = 0;
      this->vo_type = typecode::FCT;
    }
};

struct native_function : public function_base
{
  typedef object (*fn_type) (interpreter *, object *, int);

  fn_type fct;

  object call (interpreter *interp, object *argv, int argc)
    {
      return (this->fct (interp, argv, argc));
    }

  object call (interpreter *interp, int argc)
    {
      call_guard g (interp, argc + 1);
      interp->push_frame (NIL, argc, 0);
      this->test_nargs (interp, argc);
      return (this->fct (interp, interp->stkend - argc -
        interpreter::frame_size, argc));
    }
};

struct function : public function_base
{
  int max_sp;
  object bcode;
  object vals;
  object env;

  int max_stack () const;

  void copy_into (function *fp)
    {
      fp->vo_full |= this->vo_full;
      fp->max_sp = this->max_sp;
      fp->min_argc = this->min_argc;
      fp->max_argc = this->max_argc;
      fp->bcode = this->bcode;
      fp->vals = this->vals;
      fp->env = this->env;
    }
};

inline function* as_fct (object obj)
{
  return ((function *)unmask (obj));
}

#ifdef KP_ARCH_WIDE

inline constexpr bool fct_p (object obj)
{
  return (itype (obj) == typecode::FCT);
}

#else

inline bool fct_p (object obj)
{
  return (varobj_p (obj) && as_varobj(obj)->vo_type == typecode::FCT);
}

#endif

inline object& fct_bcode (object obj)
{
  return (as_fct(obj)->bcode);
}

inline object& fct_vals (object obj)
{
  return (as_fct(obj)->vals);
}

inline object& fct_env (object obj)
{
  return (as_fct(obj)->env);
}

inline native_function* as_native_fct (object obj)
{
  return ((native_function *)unmask (obj));
}

inline bool native_fct_p (object obj)
{
  return (fct_p (obj) &&
    as_fct(obj)->flagged_p (function_base::native_flag));
}

inline object& fct_name (object obj)
{
  return (((function_base *)unmask (obj))->name);
}

// Get the name of FCT as a C-string.
KP_EXPORT const char* fct_sname (object fct);

// Allocate a function with flags FLAGS.
KP_EXPORT object alloc_fct (interpreter *interp, uint32_t flags = 0);

// Test for function equality.
KP_EXPORT bool eq_xx (interpreter *interp, object x, object y);

// Compile the expression EXPR and return a thunk.
KP_EXPORT object compile_expr (interpreter *interp, object expr);

// Evaluate the expression EXPR.
KP_EXPORT object eval (interpreter *interp, object expr);

// Return the single macro-expansion of EXPR in environment ENV.
KP_EXPORT object macroexp_1 (interpreter *interp,
  object expr, object env = NIL);

// Return the full macro-expansion of EXPR in environment ENV.
KP_EXPORT object macroexp (interpreter *interp, object expr, object env = NIL);

// Call function after having pushed it and its N arguments on the stack.
KP_EXPORT object call_n (interpreter *interp, uint32_t n);

// Compute the needed stack size for function FCT.
KP_EXPORT int fct_stacksize (object fct);

struct stream;
struct io_info;
struct pack_info;

// Write a function to a stream.
KP_EXPORT int write_x (interpreter *interp,
  stream *strm, object obj, io_info& info);

// Serialize a function in a stream.
KP_EXPORT int64_t pack_x (interpreter *interp,
  stream *strm, object obj, pack_info& info);

// Deserialize a function in a stream.
KP_EXPORT object unpack_x (interpreter *interp,
  stream *strm, pack_info& info, bool save);

// Disassemble the function FN and write the instructions to OUT.
KP_EXPORT void disasm (interpreter *interp, object fn, object out);

// Get the builtin index for function named NAME.
KP_EXPORT int builtin_idx (interpreter *interp, const char *name);

// Return the builtin function for NAME.
KP_EXPORT object builtin_fct (interpreter *interp, const char *name);

// Return the builtin function with index IDX.
KP_EXPORT object builtin_fct (interpreter *interp, int idx);

// Helper for the implementation of multimethods.
KP_EXPORT object p_meth_ctl (interpreter *interp, object *argv, int argc);

// Try to call method with ARGC arguments on the stack.
KP_EXPORT bool method_call (interpreter *interp, uint32_t argc);

// Helpers for the KP_CALL macro.

template <class ...Args>
struct callvec
{
  object args[1 + sizeof... (Args)];

  callvec (Args... args)
    {
      object elems[] = { 0, args... };
      for (size_t ix = 1; ix < KP_NELEM (elems); ++ix)
        this->args[ix - 1] = elems[ix];
    }

  uint32_t operator() (interpreter *interp)
    {
      for (size_t ix = 0; ix < KP_NELEM (this->args) - 1; ++ix)
        interp->push (this->args[ix]);
      return (KP_NELEM (this->args) - 1);
    }
};

template <class ...Args>
callvec<Args...> make_callvec (Args... args)
{
  return (callvec<Args...> (args...));
}

template <class Ax>
object call_wvec (interpreter *interp, object fn, const Ax& ax)
{
  interp->push (fn);
  uint32_t nargs;

  {
    local_gc_guard g { interp };
    nargs = ax() (interp);
  }

  return (call_n (interp, nargs));
}

template <class Ax>
object call_wvec (interpreter *interp,
  object (*fn) (interpreter *, object *, int), const Ax& ax)
{
  uint32_t nargs;

  {
    local_gc_guard g { interp };
    nargs = ax() (interp);
  }

  return (fn (interp, interp->stkend - nargs, nargs));
}

// Call FN with arguments.
#define KP_CALL(Interp, Fn, ...)   \
  khipu::call_wvec ((Interp), (Fn),   \
    [&] () { return (khipu::make_callvec (__VA_ARGS__)); })

struct kwpair
{
  union
    {
      const char *name;
      object *obj;
    };
  bool is_name;

  kwpair (const char *cs) : name (cs), is_name (true)
    {
    }

  kwpair (object *ptr) : obj (ptr), is_name (false)
    {
    }
};

KP_EXPORT void kwargs_parse_pairs (interpreter *interp,
  object *argv, int argc, kwpair *pairs, int npairs);

template <class ...Args>
void kwargs_parse (interpreter *interp, object *argv, int argc, Args... args)
{
  kwpair pairs[] = { args... };
  return (kwargs_parse_pairs (interp, argv, argc, pairs, KP_NELEM (pairs)));
}

KP_DECLS_END

#endif
